home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPX30.ZIP / DEMO07.ZIP / DEMO07.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-13  |  3.6 KB  |  175 lines
  1. Program Demo7;
  2.  
  3. { SPX library - Sound demo 7  Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,dos,spx_snd,spx_key,spx_fnc,spx_ems;
  6.  
  7. type
  8.   sndmode = (CHKsnd,PCsnd,LPT1snd,SBsnd);
  9.  
  10. const
  11.   path    = '';
  12.   uems    : boolean = false;
  13.   sound   : array[0..2] of Psound = (nil,nil,nil);
  14.   sndport : word = $42;         { default device = PC speaker }
  15.   _sb     : boolean = false;
  16.   defsnd  : sndmode = CHKsnd;
  17.  
  18. var
  19.   ch : char;
  20.  
  21. procedure setup;
  22. var
  23.   d : integer;
  24. begin
  25.   setrate(8192);  { Sample rate for files is 8192 }
  26.   for d := 0 to 2 do
  27.     if uems
  28.       then sound[d]  := new(PEMSsound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb))
  29.       else sound[d]  := new(Psound,init(path+'sound'+st(d+1)+'.sfx',sndport,_sb));
  30. end;
  31.  
  32.  
  33. procedure showit;
  34. begin
  35.   clrscr;
  36.   writeln('Command line:');
  37.   writeln(' DEMO7  [PC][SB][LPT1]');
  38.   writeln('     PC    - use pc speaker');
  39.   writeln('     SB    - use sound blaster or compatible');
  40.   writeln('     LPT1  - use DAC device on LPT1');
  41.   writeln('Keys:');
  42.   writeln(' ESC          - quit demo');
  43.   writeln(' 1..3         - play sounds');
  44.   writeln;
  45.   write('Press SPACE to continue');
  46.   clearbuffer;
  47.   repeat until key[KEY_SPACE];
  48. end;
  49.  
  50.  
  51. function getvst(s:string;b:byte):string;
  52. var
  53.   v : string;
  54. begin
  55.   inc(b); v := '';
  56.   while (b<=length(s)) and (s[b]<>#32) do
  57.     begin
  58.       v := v+s[b];
  59.       inc(b);
  60.     end;
  61.   getvst := v;
  62. end;
  63.  
  64.  
  65. { convert a hex number to a decimal }
  66. function hex2dec(what:string) : integer;
  67. var
  68.   i,rslt : integer;
  69. begin
  70.   rslt := 0;
  71.   for i := 1 to length(what) do
  72.     begin
  73.       rslt := rslt shl 4;
  74.       if what[i]<'A'
  75.         then rslt := rslt+(ord(what[i])-$30)
  76.         else rslt := rslt+(ord(what[i])-55);
  77.     end;
  78.   hex2dec := rslt;
  79. end;
  80.  
  81.  
  82. function blastercheck:boolean;
  83. var
  84.   s : string;
  85. begin
  86.   s := ups(getenv('BLASTER'));
  87.   if pos('A',s)<>0
  88.     then
  89.       begin
  90.         sndport := hex2dec(getvst(s,pos('A',s)));
  91.         _sb := SBReset(sndport);
  92.         if not _sb
  93.           then
  94.             begin
  95.               sndport := SBfindBase; _sb := (sndport<>0);
  96.               if not _sb
  97.                 then sndport := $42;
  98.             end;
  99.       end;
  100.   blastercheck := _sb;
  101. end;
  102.  
  103.  
  104. procedure checkparms;
  105. var
  106.   tp,pa : word;
  107.   s     : string;
  108.   d     : integer;
  109. begin
  110.   writeln('SPX library - Sound demo 7');
  111.   writeln('Copyright 1993 Scott D. Ramsay');
  112.   writeln;
  113.   s := '';
  114.   for d := 1 to paramcount do
  115.     s := s+ups(paramstr(1));
  116.   if pos('LPT1',s)<>0
  117.     then defsnd := LPT1snd
  118.     else
  119.   if pos('SB',s)<>0
  120.     then defsnd := SBsnd
  121.     else
  122.   if pos('PC',s)<>0
  123.     then defsnd := PCsnd;
  124.   if not EMSinstalled or not emsSTATUS
  125.     then uems := false
  126.     else
  127.       begin
  128.         EMSpages(tp,pa);
  129.         if pa>=5
  130.           then
  131.             begin
  132.               uems := true;
  133.               writeln('Expanded memory detected and used')
  134.             end
  135.           else writeln('Expanded memory detected, but not enough available');
  136.       end;
  137.   case defsnd of
  138.     CHKsnd,
  139.     SBsnd   : blastercheck;
  140.     LPT1snd : sndport := $378;
  141.   end;
  142.   if _sb
  143.     then writeln('Sound card detected')
  144.     else
  145.       if defsnd<>LPT1snd
  146.         then writeln('Using PC speaker')
  147.         else writeln('Using DAC on LPT1');
  148.   writeln;
  149. end;
  150.  
  151.  
  152. procedure animate;
  153. begin
  154.   clrscr;
  155.   writeln('ESC - quit    1..3 - sounds ');
  156.   repeat
  157.      if KeyPressed
  158.        then
  159.           begin
  160.             ch := ReadKey;
  161.           if vl(ch) in [1..3]
  162.             then sound[vl(ch)-1]^.play(true);
  163.         end;
  164.     delay(100);  { kill some cycles }
  165.   until key[KEY_ESC];
  166. end;
  167.  
  168.  
  169. begin
  170.   checkparms;
  171.   showit;
  172.   setup;
  173.   animate;
  174. end.
  175.